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-- file: PeepholeZ.mesa, edited by Sweet on August 2, 1978 11:07 AM 

DIRECTORY 

CodeDefs: FROM "codedefs" USING [CCIndex, CCNull , ChunkBase, CodeCCIndex, JumpCCIndex], 

ComData: FROM "comdata" USING [dStar], 

FOpCodes: FROM "fopcodes" USING [qADD, qALLOC , qAND, qBCAST, qBCASTL, qBITBLT, qBLT, qBLTC, qBLTCL, q 
♦■^BLTL, qBRK. qCATCH, qDAOO. qDBL, qDCOMP, qDESCB. qDESCBS, qDIV, qDST, qDSUB, qDUP, qDWDC, qEFC, qEXCH 
**, qFREE, qGADRB, qlNC. qlWDC, qKFCB, qLADRB. qLDIV. qLFC, qLG. qLGD, qLI , qLINKB, qLL, qLLD, qLLK, qL 
**P. qLST, qLSTF. qME , qMEL. qMRE, qMREL, qMUL. qMXD, qMXDL, qMXW, qMXWL, qNEG, qNOOP, qNOTIFY, qNOTIFY 
**L, qOR. qPOP, qPORTI, qPORTO. qPS, qPSD, qPSF, qPUSH, qR, qRD, qRDL, qREQUEUE, qREQUEUEL, qRET, qRF, 
**qRFC, qRFL, qRFS, qRFSL, qRIG, qRIGL. qRIL, qRILL, qRL, qRR, qRSTR, qRSTRL, qRXGL, qRXL, qRXLL. qSFC, 
♦* qSG, qSGD, qSHIFT, qSL, qSLD. qSTARTIO, qSTOP, qSUB . qW. qWD , qWDL. qWF , qWFL. qWFS. qWFSL, qWIGL. q 
**WIL, qWILL, qWL, qWR, qWS, qWSD, qWSF, qWSTR, qWSTRL. qWXGL, qWXL, qWXLL. qXOR], 

Mopcodes: FROM "mopcodes" USING [zADD, zADDOl, zALLOC, zAND, zBCAST, zBITBLT, zBLT, zBLTC, zBLTCL, zB 
**LTL, zBRK, zCATCH. zDAOO. zDBL, zDCOMP, zDESCB, zDESCBS, zDIV, zDST, zDSUB, zDUP. zDWDC. zEFCB, zEXCH 
**, zFREE, zGADRB, zINC, zIWDC. zKFCB, zLADRB, zLDIV. zLFCB, zLGB, zLGDB. zLIO, zLLB, zLLDB, zLLKB. zLP 
*♦, zLST, zLSTF. zME, zMRE. zMUL, zMXD. zMXW, zNEG, zNOTIFY, zOR, zPOP, zPORTI . zPORTO. zPUSH, zPUSHX, 
♦♦zRO. zRB, zRBL, zRDO, zRDB . zRDBL. zREQUEUE, zRET, zRF. zRFC, zRFL. zRFS, zRFSL, zRIGP, zRIGPL, zRILP 
**, zRILPL, zRR, zRSTR, zRSTRL. zRXGPL, zRXLP, zRXLPL. zSFC, zSGB, zSGDB, zSHIFT, zSLB, zSLDB. zSTARTIO 
♦♦, zSTOP, zSUB, zWO, zWB. zWBL, zWDO, zWOB , zWDBL, zWF, zWFL. zWFS, zWFSL, zWIGPL, zWILP, zWILPL, zWR, 
** zWSO, zWSB. zWSDB, zWSF. zWSTR. zWSTRL. zWXGPL, zWXLP, zWXLPL. zXOR], 

OpCodeParams: FROM "opcodeparams" USING [BYTE. ExternalProcBase , ExternalProcSlots, GlobalBase. Globa 
**1LoadSlots, GlobalStoreSlots, LocalBase, LocalLoadSl ots, LocalProcBase, LocalProcSlots, LocalStoreSlo 
**ts, ReadSlots, RILSlots, WriteSlots. zEFCn, zLFCn, zLGn, zLLn, zRILn, zRn. zSGn, zSLn, zWn], 

OpTableDefs: FROM "optabledef s" USING [instlength], 

P5ADefs: FROM "p5adefs" USING [deletecell. NumberOfParams, P5Error]. 

P5BDefs: FROM "p5bdefs" USING [CO, CI, C2, LoadConstant] , 

PeepholeDefs: FROM "peepholedef s" USING [InitParametersC, PackPair, PeepState], 

TableDefs: FROM "tabledefs" USING [TableNotif ier], 

TreeDefs: FROM "treedefs" USING [treetype]; 

PeepholeZ: PROGRAM 

IMPORTS MPtr: ComData, OpTableDefs, P5ADefs, PSBDefs. PeepholeDefs 

EXPORTS CodeDefs, PeepholeDefs » 

BEGIN OPEN P5ADefs, P5BDefs. PeepholeDefs, OpCodeParams, CodeDefs; 

-- imported definitions 

BYTE: TYPE = OpCodeParams. BYTE ; 
qNOOP: BYTE = FOpCodes . qNOOP; 
CodeCCIndex: TYPE = CodeDefs. CodeCCIndex; 
JumpCCIndex: TYPE = CodeDefs .JumpCCIndex; 

cb: ChunkBase; -- code base (local copy) 

PeepholeZNotify: PUBLIC TableDefs .TableNotif ier « 

BEGIN -- called by allocator whenever table area is repacked 

cb <- LOOPHOLE[base[TreeDefs. treetype]]; 

RETURN 

END; 

dummy: PRIVATE PROCEDURE « 
BEGIN 

state: PeepState; 
IF FALSE THEN [] ^ state; 
END; 

Unconvertedlnstruction: SIGNAL [opcode: WORD] « CODE; 

cpeepz: PUBLIC PROCEDURE [start: CodeCCIndex] » 

BEGIN -- convert to real instructions (ie from qXXX to zXXX) 
OPEN Mopcodes, FOpCodes; 
next: CodeCCIndex; 
state: PeepState; 

next <- start; 
BEGIN OPEN state; 
UNTIL (c <- next) = CCNull DO 
next ^ LOOPHOLE[cb[c].flink]; 
WITH cb[LOOPHOLE[c, CCIndex]] SELECT FROM 
code "> 
IF ~cb[c].realinst THEN 
BEGIN 

InitParametersC[@state]; 
SELECT cinst FROM 
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store, double, 
single, cp[l], 



qWL 
qRF 
qWF 



cp[l] 
, cp[l 



qLG -> 

BEGIN Move\/ar[global , load, 
qSG ■> 

BEGIN MoveVar[global , store 
qLL -> 

BEGIN Move\/ar[1ocal , load, single, 
qSL »> 

BEGIN Move\/ar[1oca1 , store, single, 
qLI «> BEGIN LoadConstant[cp[l]] ; del 
qLGD -> 

BEGIN Move\/ar[global , load, double, 
qSGD -> 

BEGIN MoveVarCglobal 
qLLD -> 

BEGIN MoveVar[local , load, double, 
qSLD ■> 

BEGIN MoveVar[local, 
qR »> BEGIN Move[read, 
qW => BEGIN Move[write, single, cp[l] 
qRL »> BEGIN Move[readlong , single, c 
»> BEGIN Move[writelong, single, 
O BEGIN Move[read, partial, cp[l 
=> BEGIN Move[write, partial, cp[ 
qRFL => BEGIN Move[readlong , partial, 
qWFL «> BEGIN Move[writelong , partial 
qRFC => MakeReal[c, zRFC] 
qRFS => MakeReal[c, zRFS] 
qWFS => MakeReal[c. zWFS] 
qRFSL => MakeReal[c. zRFSL]; 
qWFSL => MakeReal[c, zWFSL]; 
qRD ==> BEGIN Move[read, double, 
qWD => BEGIN Move[write, double 
qRSTR => MakeReal[c, zRSTR]; 
qWSTR => MakeRealfc, zWSTR]; 
qRXL => MakeLPReal[c, zRXLP]; 
qWXL => MakeLPReal[c, zWXLP]; 
qRIG => MakeGPReal[c, zRIGP]; 
qRIL => IF cp[l] « LocalBase AND cp[2 

THEN BEGIN C0[zRILn+cp[2]] ; deletec 

ELSE MakeLPReal[c. zRILP]; 
qWIL => MakeLPReal[c, zWILP]; 
qRDL => BEGIN Move[readlong , double, 
qWDL => BEGIN Move[writelong , double, 
qRSTRL => MakeReal[c, zRSTRL]; 
qWSTRL => MakeReal[c, zWSTRL]; 
qRXGL => MakeGPReal[c, zRXGPL] 
qWXGL => MakeGPReal[c, zWXGPL] 
qRXLL => MakeLPReal[c, zRXLPL] 
qWXLL =»> MakeLPReal[c, zWXLPL] 
qRIGL => MakeGPReal[c, zRIGPL] 
qWIGL »> MakeGPReal[c, zWIGPL] 
qRILL => MakeLPReal[c, zRILPL] 
qWILL => MakeLPReal[c. zWILPL] 
qWS «> BEGIN Move[swrite, single, cp[ 
qWSF => BEGIN Move[swrite, partial, c 
qWSD => BEGIN Move[swrite, double, cp 
qPS => BEGIN Move[sput, single, cp[l] 
qPSF => BEGIN MoveCsput, partial, cp[ 
=> BEGIN Move[sput, double, cp[l 
=> MakeRealFast[c:c, slow:zADD, 
=> MakeReal[c, zSUB]; 
qDADD «> MakeReal[c, zDADD]; 
qDSUB => MakeRealfc, zDSUB]; 
qDCOMP => MakeReal[c, zDCOMP]; 
qMUL => MakeReal[c, zMUL]; 
qDIV «> MakeReal[c, zDIV]; 
qLDIV «> MakeReal[c, zLDIV]; 
qNEG «> MakeReal[c, zNEG]; 
qAND «> MakeRealfc, zAND]; 
qOR »> MakeReal[c, zOR]; 
qXOR -> MakeReal[c» zXOR]; 
qSHIFT •> MakeReal[c, zSfllFT]; 
qPUSH «> MakeReal[c, zPUSH]; 
qPOP «> MakeReal[Ci zPOP]; 
qEXCH «> MakeReal[c, zEXCH]; 
qCATCH «>vMakeReal[c, zCATCH]; 



single, cp[l]]; deletecel 1 [c] END; 

single, cp[l]]; deletecel iCc] END; 

cp[l]]; deletecell[c] END; 

cp[l]]; deletecell[c] END; 
etecell[c] END; 

cp[l]]; deletecell[c] END; 

store, double, cp[l]]; deletecel l[c] END; 

cp[l]]; deletecell[c] END; 



cp[l]]; deletecell[c] END; 

0]; deletecell[c] END; 
. 0]; deletecell[c] END; 
p[l], 0]; deletecell[c] END; 
cp[l], 0]; deletecell[c] END; 
]. cp[23]; deletecell[c] END; 
1], cp[2]]; deletecell[c] END; 

cp[l], cp[2]]; deletecell[c] END; 
, cp[l], cp[2]]; deletecell[c] END; 



, 0]; deletecell[c] END; 
], 0]; deletecell[c] END; 



] IN RILSlots 
ell[c] END 



cp[l], 0]; deletecell[c] END; 
cp[l], 0]; deletecell[c] END; 



qPSD 
qADD 
qSUB 



1], 0]; deletecell[c] END; 

p[l]. cp[2]]; deletecell[c] END; 

[1], 0]; deletecell[c] END; 

, 0]; deletecellCc] END; 

l]i cp[2]]; deletecellCc] END; 

], 0]; deletecell[c] END; 

fast:zADD01]; 
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qEFC ■> 

IF cp[l] IN ExternalProcSlots THEN 

BEGIN C0[zEFCn+cp[l]-Externa1ProcBase]; deletecellCc] END 

ELSE MakeRea1[c, zEFCB]; 
qLLK => MakeRea1[c. zLLKB]; 
qLFC »> 

IF cp[l] IN LocalProcSlots THEN 

BEGIN CO[zLFCn+cp[l]-LocalProcBase]; d8letecen[c] END 

ELSE MakeRea1[c, zLFCB]; 
qSFC «> MakeRea1[c, zSFC]; 
qRET => MakeRealfc, zRET]; 
qPORTO «> MakeRea1[c, zPORTO]; 
qPORTI «> MakeRea1[c, zPORTI]; 
qKFCB »> MakeReal[c, zKFCB]; 
qBLT => MakeReal[c, zBLT]; 
qBLTL => MakeReal[c, zBLTL]; 
qBLTC »> MakeReal[c, zBLTC]; 
qBLTCL => MakeRea1[c. zBLTCL]; 
qALLOC => MakeRea1[c, zALLOC]; 
qFREE => MakeReal[c. zFREE]; 
qSTOP => MakeReal[c, zSTOP]; 
qBITBLT => MakeRea1[c, zBITBLT]; 
qSTARTIO => MakeReal[c, zSTARTIO]; 
qDST => MakeReal[c» zDST]; 
qLST => MakeReal[c. zLST]; 
qLSTF => MakeReal[c, zLSTF]; 
qWR => MakeRea1[c, zWR]; 
qRR => MakeReal[c, zRR]; 
qBRK => MakeReal[c. zBRK]; 

qLINKB => BEGIN CO[zPUSHX]; del etecell [c] END; 
qLADRB => MakeReal[c, zLADRB]; 
qGADRB => MakeRealfc. zGADRB]; 
qINC => MakeReal[c. zINC]; 
qDUP => MakeReal[c. zDUP]; 
qDBL => MakeRea1[c. zDBL]; 
qDWDC => MakeReal[c, zDWDC]; 
qlWDC => MakeRea1[c. zIWDC]; 
qDESCB => MakeRea1[c, zDESCB]; 
qDESCBS => MakeReal[c, zDESCBS]; 

qLP => MakeRea1[c. IF MPtr.dStar THEN zLP ELSE zLIO]; 
qME, qMEL => MakeRea1[c, zME]; 
qMRE. qMREL «> MakeRea1[c, zMRE]; 
qMXW. qMXWL => MakeReal[c, zMXW] ; 
qMXD. qMXDL => MakeReal[c, zMXD]; 
qNOTIFY. qNOTIFYL => MakeReal[c. zNOTIFY]; 
qBCAST, qBCASTL => MakeReal[c. zBCAST]; 
qREQUEUE, qREQUEUEL => MakeReal[c. zREQUEUE]; 



ENDCASE 

BEGIN SIGNAL UnconvertedInstruction[cinst] ; 
END; 
ENDCASE; -- of WITH 
ENDLOOP; 
END; -- of OPEN state 
RETURN 
END; 



deletecen[c] END; 



MakeReal: PROCEDURE [c: CodeCCIndex, i: BYTE] = 
BEGIN 

IF cb[c].rea1inst OR NumberOfParams[cb[c] . inst] # OpTableDefs . instlengtti[i]-l THEN P5ADef s.P5Error[ 
**1025]; 

cb[c] . inst ^ i ; 
cb[c].rea1 inst <- TRUE; 
RETURN 
END; 

MakeRealFast: PROCEDURE [c: CodeCCIndex, slow, fast: BYTE] - 
BEGIN 

IF cb[c].rea1inst OR NumberOfParams[cb[c]. inst] if OpTableDefs . instlength[s1ow]-l THEN P5ADef s.PSErr 
**or[1026]; 

cb[c].inst <- IF cb[c] .minimalStack THEN fast ELSE slow; 

cb[c].realinst ^ TRUE; 

RETURN 

END; 



MakeLPReal: PROCEDURE [c: CodeCCIndex, i: BYTE] 
BEGIN 
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IF cb[c].realinst OR NumberOfPararns[cb[c] . inst] ^ OpTableDef s . instlength[i]-l+l THEN P5ADef s .P5Erro 
**r[1027]; 

Cl[i , PackPair[cb[c].parani8ters[l] -Local Base, cb[c].parani8ters[2]]]; 

de1etecen[c]; 

RETURN 

END; 

MakeGPReal: PROCEDURE [c: CodeCCIndex, i: BYTE] - 
BEGIN 

IF cb[c].rea1inst OR NumberOFParams[cb[c] . inst] # OpTableDefs . instlength[i]-l+l THEN P5ADef s .P5Erro 
♦♦r[1028]; 

Cl[i , PackPair[cb[c].parameters[l]-G1obalBase. cb[c] .parameter s[2]]] ; 

de1etecen[c]; 

RETURN 

END; 

cpeep9: PROCEDURE ■ 

BEGIN -- find 2-instruction sequences 

RETURN 

END; 

cpeeplO: PROCEDURE « 

BEGIN -- find bit-testing jumps 

RETURN 

END; 

Mdirection: TYPE = {read, write, swrite, sput, readlong, writelong}; 
Mtype: TYPE = {single, double, partial}; 
MVdirection: TYPE = {load, store, put}; 
MVtype: TYPE = {single, double}; 
MVclass: TYPE = {global, local}; 

MoveB: ARRAY MVclass OF ARRAY MVtype OF 

PACKED ARRAY MVdirection[load .. store] OF BYTE ^ [ 

[[Mopcodes.zLGB, Mopcodes .zSGB] , [Mopcodes .zLGDB. Mopcodes.zSGDB]], 
[[Mopcodes.zLLB, Mopcodes . zSLB] , [Mopcodes .zLLDB, Mopcodes .zSLDB]]]; 

MoveVar: PROCEDURE [c: MVclass, d: MVdirection, t: MVtype, offset: WORD] • 
BEGIN -- handles LG, SG, LL, SL, LGD, SGD, LLD, SLD, PL class instructions 
OPEN Mopcodes; 
IF t =■ single THEN 
IF c = local THEN 
SELECT d FROM 

load => IF offset IN LocalLoadSlots THEN 

BEGIN CO[zLLn+offset-LocalBase]; RETURN END; 
store => IF offset IN LocalStoreSlots THEN 

BEGIN CO[zSLn+offset-LocalBase]; RETURN END; 
ENDCASE 
ELSE 

SELECT d FROM 

load -> IF offset IN GlobalLoadSlots THEN 

BEGIN CO[zLGn+offset-GlobalBase]; RETURN END; 
store => IF offset IN GlobalStoreSlots THEN 

BEGIN CO[zSGn+offset-GlobalBase]; RETURN END; 
ENDCASE; 
IF offset --IN BYTE THEN 
BEGIN 

C1[IF c = global THEN zGADRB ELSE zLADRB, LAST[BYTE]]; 
LoadConstant[offset - LAST[BYTE]]; CO[zADD]; 
IF t = single THEN IF d » load THEN CO[zRO] ELSE CO[zWO] 
ELSE IF d = load THEN C0[zRDO] ELSE COfzWDO]; 
RETURN 
END; 
Cl[MoveB[c][t][d]. offset]; 
RETURN 
END; 

Move: PROCEDURE [d: Mdirection, t: Mtype. offset, field: WORD] ■ 
BEGIN -- handles R, W, RF, WF, WS , WSF, PS, PSF class instructions 
OPEN Mopcodes; 

IF d « read AND t - single AND offset IN ReadSlots THEN 

BEGIN CO[zRn+offset]; RETURN END; 
IF d « write AND t - single AND offset IN WriteSlots THEN 
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BEGIN CO[zWn+offset]; RETURN END; 
IF offset -IN BYTE THEN 
BEGIN 

LoadConstant[offset]; 
IF d >« readlong THEN 

BEGIN LoadConstant[0]; CO[zDADD] END 
ELSE C0[zADD3; 
offset ♦- 0; 
END; 
IF offset » AND d < readlong THEN 
SELECT d FROM 

read -> SELECT t FROM 
single »> CO[zRO]; 
double -> CO[zRDO]; 
partial »> C2[zRF. 0, field]; 
ENDCASE; 
write «> SELECT t FROM 
single »> CO[zWO]; 
double «> CO[zWDO]; 
partial «> C2[zWF, 0, field]; 
ENDCASE; 
swrite, sput «> SELECT t FROM 
single «> CO[zWSO]; 
double -> Cl[zWSDB, 0]; 
partial => C2[zWSF. 0. field]; 
ENDCASE; 
ENDCASE 
ELSE 

SELECT d FROM 

read => SELECT t FROM 

single «> Cl[zRB, offset]; 
double => ClCzRDB, offset]; 
partial => C2[zRF, offset, field]; 
ENDCASE; 
write => SELECT t FROM 

single => Cl[zWB, offset]; 
double => Cl[zWDB. offset]; 
partial => C2[zWF, offset, field]; 
ENDCASE; 
swrite, sput «> SELECT t FROM 
single => Cl[zWSB, offset]; 
double => Cl[zWSDB, offset]; 
partial => C2[zWSF. offset, field]; 
ENDCASE; 
readlong «> SELECT t FROM 
single => Cl[zRBL, offset]; 
double => Cl[zRDBL. offset]; 
partial => C2[zRFL, offset, field]; 
ENDCASE; 
writelong => SELECT t FROM 
single => Cl[zWBL, offset]; 
double => Cl[zWDBL. offset]; 
partial »> C2[zWFL, offset, field]; 
ENDCASE; 
ENDCASE; 
IF d = sput THEN CO[zPUSH]; 
RETURN 
END; 



END.. . 



